home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dispca1a / form1.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-09-08  |  4.5 KB  |  125 lines
  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  4. Begin VB.Form Form1 
  5.    Caption         =   "Form1"
  6.    ClientHeight    =   5430
  7.    ClientLeft      =   60
  8.    ClientTop       =   345
  9.    ClientWidth     =   6675
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   5430
  12.    ScaleWidth      =   6675
  13.    StartUpPosition =   3  'Windows Default
  14.    Begin MSComctlLib.StatusBar StatusBar1 
  15.       Align           =   2  'Align Bottom
  16.       Height          =   285
  17.       Left            =   0
  18.       TabIndex        =   1
  19.       Top             =   5145
  20.       Width           =   6675
  21.       _ExtentX        =   11774
  22.       _ExtentY        =   503
  23.       _Version        =   393216
  24.       BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
  25.          NumPanels       =   1
  26.          BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  27.             Alignment       =   2
  28.             Object.Width           =   8819
  29.             MinWidth        =   8819
  30.          EndProperty
  31.       EndProperty
  32.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  33.          Name            =   "MS Sans Serif"
  34.          Size            =   9.75
  35.          Charset         =   0
  36.          Weight          =   700
  37.          Underline       =   0   'False
  38.          Italic          =   0   'False
  39.          Strikethrough   =   0   'False
  40.       EndProperty
  41.    End
  42.    Begin RichTextLib.RichTextBox text1 
  43.       Height          =   4065
  44.       Left            =   30
  45.       TabIndex        =   0
  46.       Top             =   780
  47.       Width           =   5805
  48.       _ExtentX        =   10239
  49.       _ExtentY        =   7170
  50.       _Version        =   393217
  51.       Enabled         =   -1  'True
  52.       TextRTF         =   $"Form1.frx":0000
  53.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  54.          Name            =   "MS Sans Serif"
  55.          Size            =   12
  56.          Charset         =   0
  57.          Weight          =   400
  58.          Underline       =   0   'False
  59.          Italic          =   0   'False
  60.          Strikethrough   =   0   'False
  61.       EndProperty
  62.    End
  63.    Begin VB.Label Label1 
  64.       Caption         =   "Label1"
  65.       Height          =   495
  66.       Left            =   120
  67.       TabIndex        =   2
  68.       Top             =   90
  69.       Width           =   5655
  70.    End
  71. Attribute VB_Name = "Form1"
  72. Attribute VB_GlobalNameSpace = False
  73. Attribute VB_Creatable = False
  74. Attribute VB_PredeclaredId = True
  75. Attribute VB_Exposed = False
  76. ' Name: DispCaretPos
  77. ' By: Herman Liu
  78. Option Explicit
  79. Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _
  80.     (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  81. Private Const EM_GETSEL = &HB0
  82. Private Const EM_LINEINDEX = &HBB
  83. Private Const EM_LINEFROMCHAR = &HC9
  84. Dim overallCursorPos As Long
  85. Dim currLinePos As Long
  86. Dim chrsBeforeCurrLine As Long
  87. Dim CurrLineCursorPos As Long
  88. Private Sub Form_Load()
  89.     Label1.Caption = "Type serveral lines for trial.  As you type or move" & _
  90.         " the cursor, statusbar updates the current line and character position"
  91. End Sub
  92. Private Sub Text1_Change()
  93.     DispCaretPos
  94. End Sub
  95. Private Sub Text1_Click()
  96.     DispCaretPos
  97. End Sub
  98. Private Sub text1_KeyUp(KeyCode As Integer, Shift As Integer)
  99.     DispCaretPos
  100. End Sub
  101. Private Sub DispCaretPos()
  102.     On Local Error Resume Next
  103.     'cursor position in the text box (incl CR & LF if any)
  104.     '(Note zero-based)
  105.     overallCursorPos = SendMessageLong(text1.hwnd, EM_GETSEL, 0, 0&) \ &H10000
  106.     'current line pos (Note: zero-based)
  107.     currLinePos = SendMessageLong(text1.hwnd, EM_LINEFROMCHAR, overallCursorPos, 0&)
  108.     'number of chrs upto but before start of the current line
  109.     ' (incl CR & LF f any)
  110.     chrsBeforeCurrLine = SendMessageLong(text1.hwnd, EM_LINEINDEX, _
  111.     currLinePos, 0&)
  112.     'cursor position in terms of current line only (Note: zero-based)
  113.     '
  114.     CurrLineCursorPos = overallCursorPos - chrsBeforeCurrLine
  115.     text1.SetFocus
  116.     ' Note, for example, if you only have 2 sections of the status
  117.     ' bar, then change 3 to 2 below.
  118.     StatusBarMsg "Pos: " & CStr(currLinePos + 1) & ":" & _
  119.     CStr(CurrLineCursorPos + 1) & Space(1), 1
  120. End Sub
  121. Private Sub StatusBarMsg(mMsg As String, mPanel As Integer)
  122.     StatusBar1.Panels(mPanel).Text = mMsg
  123.     StatusBar1.Refresh
  124. End Sub
  125.